home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 February / EnigmA AMIGA RUN 15 (1997)(G.R. Edizioni)(IT)[!][issue 1997-02][PLANET CD V].iso / progs / thor / thor_2.4 / thor.lha / rexx / GetNET.thor < prev    next >
Text File  |  1996-11-11  |  12KB  |  460 lines

  1. /*
  2.  $VER: GetNET.Thor 1.4 (30.6.96)
  3.  by Remco van Hooff
  4.  
  5.  See GetNET.thor.doc for installation instructions.
  6. */
  7.  
  8. bbs       = 'Email'        /* your Internet system */
  9.  
  10. /* hotlists */
  11. hotlist_amosaic = 'envarc:mosaic/.mosaic-hotlist-default' ; amosaic = 1
  12. hotlist_ibrowse = 'IBrowse:ibrowse-hotlist.html'          ; ibrowse = 1
  13. hotlist_aweb    = 'AWeb:aweb.hotlist'                     ; aweb    = 1
  14. hotlist_voyager = 'Voyager:bookmarks.html'                ; voyager = 1
  15. hotlist_html    = 'path_to_hotlist:hotlist.html'          ; html    = 0
  16.  
  17. /* loop or not */
  18. loop = 0
  19.  
  20. /* don't edit these */
  21. cr = '0d'x
  22. lf = '0a'x
  23. tab= '09'x
  24.  
  25. /* filter chars, expand if you want */
  26.  
  27. /* after the address */
  28. filter.1.1 = cr
  29. filter.1.2 = lf
  30. filter.1.3 = ')'
  31. filter.1.4 = ','
  32. filter.1.5 = "'"
  33. filter.1.6 = '"'
  34. filter.1.7 = ']'
  35. filter.1.8 = '>'
  36. filter.1.9 = '}'
  37. filter.1.10 = '*'
  38. filter.1.count = 10 /* number of filters */
  39.  
  40. /* in front of the address (only for email)*/
  41. filter.2.1 = '('
  42. filter.2.2 = '"'
  43. filter.2.3 = '<'
  44. filter.2.4 = '['
  45. filter.2.5 = '{'
  46. filter.2.6 = ':'
  47. filter.2.7 = "'"
  48. filter.2.8 = tab
  49. filter.2.count = 8
  50.  
  51. /*--------------------------------------------------------------------------*/
  52. tempfile  = 't:temp.tmp'
  53. OPTIONS FAILAT 31
  54. if left(address(), 5) = 'THOR.' then thorport = address()
  55. else do
  56.   say 'THOR port not found!'
  57.   exit 10
  58. end
  59.  
  60. IF ~SHOW('p', 'BBSREAD') THEN DO
  61.   ADDRESS COMMAND
  62.     "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  63.     "WaitForPort BBSREAD"
  64. END
  65.  
  66. ADDRESS(thorport)
  67. OPTIONS RESULTS
  68.  
  69. CURRENTMSG stem MSG
  70. IF(RC ~= 0) THEN DO
  71.   REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  72.   EXIT
  73. END
  74. msgnum  = MSG.MSGNR
  75. curbbs  = MSG.BBSNAME
  76. curconf = MSG.CONFNAME
  77.  
  78. ADDRESS bbsread READBRMESSAGE BBSNAME '"'curbbs'"' CONFNAME '"'curconf'"' MSGNR msgnum HEADSTEM headtags
  79. IF(RC ~= 0) THEN DO
  80.   REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  81.   EXIT
  82. END
  83. fromname = HEADTAGS.FROMNAME
  84. subj = HEADTAGS.SUBJECT
  85. IF POS('RE:',UPPER(subj)) ~=0 THEN subj = SUBSTR(subj,5)
  86.  
  87. CALL main
  88. EXIT
  89.  
  90. main:
  91.   DROP FOUND. SAVE. NAME.
  92.   REQUESTNOTIFY TEXT '"Choose what kind of addresses to get."' BT '"_HTTP|_Email|_Quit"'
  93.   IF RESULT = 0 THEN EXIT
  94.   IF RESULT = 1 THEN CALL get_http
  95.   IF RESULT = 2 THEN CALL get_email
  96.   IF loop = 1 THEN SIGNAL main
  97. RETURN
  98.  
  99. /* gethttp */
  100. get_http:
  101. SAVEMESSAGE CURRENT FILENAME tempfile NOANSI OVERWRITE
  102. IF(RC ~= 0) THEN DO
  103.   REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  104.   EXIT
  105. END
  106.  
  107. ELSE DO
  108.   CALL gethttp
  109.   CALL listfound
  110.   IF ok = 1 THEN CALL listsave(1)
  111. END
  112. RETURN
  113.  
  114. gethttp:
  115.   CALL OPEN(tmp, tempfile, 'r')
  116.     num = 0
  117.     found.count = 0
  118.     DO WHILE ~EOF(tmp)
  119.       msg = READLN(tmp)
  120.       msg = TRANSLATE(msg, 'hptw', 'HPTW')
  121.       IF (POS('ttp://', msg) = 0 & POS('www.', msg) ~=0 ) THEN DO
  122.         PARSE VAR msg . 'www.' httpadres .
  123.         IF httpadres ~= ''THEN httpadres = 'www.'||httpadres
  124.       END
  125.       ELSE DO
  126.         PARSE VAR msg . 'ttp://' httpadres .
  127.       END
  128.       IF httpadres ~= '' THEN DO
  129.         lengte = length(httpadres)
  130.         CALL filter(httpadres, lengte,1)
  131.         httpadres = 'http://'||RESULT
  132.         n = 0
  133.         DO i = 1 TO found.count
  134.           IF httpadres ~= found.i THEN n = n +1
  135.         END        
  136.         IF n = found.count THEN DO
  137.           num = num + 1
  138.           found.num = httpadres
  139.           found.count = num
  140.         END
  141.       END
  142.     END
  143.   CALL CLOSE(tmp)
  144.   ADDRESS COMMAND 'delete >nil: 'tempfile
  145. RETURN
  146.  
  147. savehotlist:
  148.   DO i = 1 TO save.count
  149.     IF name.i = '' THEN name.i = subj '('i')'
  150.   END
  151.   IF amosaic = 1 THEN CALL save_amosaic
  152.   IF ibrowse = 1 THEN CALL save_ibrowse
  153.   IF html    = 1 THEN CALL save_html
  154.   IF aweb    = 1 THEN CALL save_aweb
  155.   IF voyager = 1 THEN CALL save_voyager
  156.   IF amosaic+ibrowse+html+aweb+voyager = 0 THEN Requestnotify '"No hotlist(s) selected."' '"_OK"'
  157.   IF loop = 1 THEN SIGNAL main
  158. RETURN
  159.  
  160. save_amosaic:
  161.   IF ~EXISTS(hotlist_amosaic) THEN DO
  162.     Requestnotify '"Amosaic hotlist not found!"' '"_OK"'
  163.     RETURN
  164.   END
  165.   ELSE DO
  166.     dat = DATE()
  167.     PARSE VAR dat dagnr maand jaar
  168.     dag = LEFT(DATE('W', DATE(S), 'S'), 3)
  169.     datum = dag maand dagnr TIME()jaar
  170.     CALL OPEN(htlst,hotlist_amosaic,'a')
  171.     DO i = 1 TO save.count
  172.       CALL WRITELN(htlst,save.i||' '||datum)
  173.       CALL WRITELN(htlst,STRIP(name.i))
  174.     END
  175.     CALL CLOSE(htlst)
  176.   END
  177.   ADDRESS COMMAND 'copy' hotlist_amosaic 'env:mosaic/ quiet'
  178. RETURN
  179.  
  180. save_ibrowse:
  181.   IF ~EXISTS(hotlist_ibrowse) THEN DO
  182.     Requestnotify '"IBrowse hotlist not found!"' '"_OK"'
  183.     RETURN
  184.   END
  185.   ELSE DO
  186.     CALL OPEN(in,hotlist_ibrowse,'r')
  187.     CALL OPEN(out,'t:IBrowse.tmp','w')
  188.       line = READLN(in)
  189.       DO UNTIL line = '<UL>'
  190.         WRITELN(out, line)
  191.         line = READLN(in)
  192.       END
  193.       WRITELN(out, line)
  194.       DO i = 1 TO save.count
  195.         IF savename.i = '' THEN savename.i = destvar.1 '('i')'
  196.         adres = '<LI><A HREF="'||save.i||'">'STRIP(name.i)'</A><br>'
  197.         WRITELN(out, adres)
  198.       END
  199.       DO UNTIL EOF(in)
  200.         rest = readch(in,1048576) /* 1MB should be enough :.) */
  201.         WRITECH(out, rest)
  202.       END
  203.     CALL CLOSE(out)
  204.     CALL CLOSE(in)
  205.     ADDRESS COMMAND 'copy t:ibrowse.tmp' hotlist_ibrowse 'quiet'
  206.     ADDRESS COMMAND 'delete t:ibrowse.tmp quiet'
  207.   END
  208. RETURN
  209.  
  210. save_html:
  211.   IF ~EXISTS(hotlist_html) THEN DO
  212.     Requestnotify '"HTML hotlist not found!"' '"_OK"'
  213.     RETURN
  214.   END
  215.   ELSE DO
  216.     CALL OPEN(htlst,hotlist_html,'a')
  217.     DO i = 1 TO save.count
  218.       CALL WRITELN(htlst,'<LI><A HREF="'save.i'">'STRIP(name.i)'</A><br>')
  219.     END
  220.     CALL CLOSE(htlst)
  221.   END
  222. RETURN
  223.  
  224. save_aweb:
  225.   IF ~EXISTS(hotlist_aweb) THEN DO
  226.     Requestnotify '"AWeb hotlist not found!"' '"_OK"'
  227.     RETURN
  228.   END
  229.   ELSE DO
  230.     CALL OPEN(htlst,hotlist_aweb,'a')
  231.     DO i = 1 TO save.count
  232.       CALL WRITELN(htlst,save.i)
  233.       CALL WRITELN(htlst,STRIP(name.i))
  234.     END
  235.     CALL CLOSE(htlst)
  236.   END
  237. RETURN
  238.  
  239. save_Voyager:
  240.   IF ~EXISTS(hotlist_voyager) THEN DO
  241.     Requestnotify '"Voyager hotlist not found!"' '"_OK"'
  242.     RETURN
  243.   END
  244.   ELSE DO
  245.     CALL OPEN(in,hotlist_voyager,'r')
  246.     CALL OPEN(out,'t:voyager.tmp','w')
  247.       line = READLN(in)
  248.       DO UNTIL line = '<UL>'
  249.         WRITELN(out, line)
  250.         line = READLN(in)
  251.       END
  252.       WRITELN(out, line)
  253.       DO i = 1 TO save.count
  254.         IF savename.i = '' THEN savename.i = destvar.1 '('i')'
  255.         adres = '<LI><A HREF="'||save.i||'">'STRIP(name.i)'</A><br>'
  256.         WRITELN(out, adres)
  257.       END
  258.       DO UNTIL EOF(in)
  259.         rest = readch(in,1048576) /* 1MB should be enough :.) */
  260.         WRITECH(out, rest)
  261.       END
  262.     CALL CLOSE(out)
  263.     CALL CLOSE(in)
  264.     ADDRESS COMMAND 'copy t:voyager.tmp' hotlist_voyager 'quiet'
  265.     ADDRESS COMMAND 'delete t:voyager.tmp quiet'
  266.   END
  267. RETURN
  268.  
  269. /* end gethttp */
  270.  
  271. /* getemail */
  272. get_email:
  273.   SAVEMESSAGE CURRENT FILENAME tempfile NOHEADER NOANSI OVERWRITE
  274.   IF(RC ~= 0) THEN DO
  275.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  276.     EXIT
  277.   END
  278.   ELSE DO
  279.     CALL getemail
  280.     CALL listfound
  281.     IF ok = 1 THEN CALL listsave(2)
  282.   END
  283. RETURN
  284.  
  285. getemail:
  286.   CALL OPEN(tmp, tempfile, 'r')
  287.     num = 0
  288.     found.count = 0
  289.     DO WHILE ~EOF(tmp)
  290.       msg = READLN(tmp)
  291.       PARSE VAR msg part1 '@' part2 '.' part3 rest
  292.       DO FOREVER
  293.         IF (part2 ~= '' & POS(' ',part2) = 0 & part3 ~= '') THEN DO
  294.           spc = LASTPOS(' ', part1)
  295.           IF spc ~= 0 THEN part1 = DELSTR(part1, 1, spc)
  296.           lengte = LENGTH(part1)
  297.           CALL filter(part1,lengte,2)
  298.           part1 = RESULT
  299.           lengte = LENGTH(part3)
  300.           CALL FILTER(part3,lengte,1)
  301.           part3 =  RESULT
  302.           email = part1'@'part2'.'adres
  303.           n = 0
  304.           DO i = 1 TO found.count
  305.             IF email ~= found.i THEN n = n +1
  306.           END        
  307.           IF n = found.count THEN DO
  308.             num = num + 1
  309.             found.num = email
  310.             found.count = num
  311.           END
  312.         END
  313.         IF POS('@', rest) ~= 0 THEN DO
  314.           PARSE VAR rest part1 '@' part2 '.' part3 rest
  315.           empty = 0
  316.         END 
  317.         ELSE empty = 1
  318.         IF empty = 1 THEN LEAVE
  319.       END
  320.     END
  321.   CALL CLOSE(tmp)
  322.   ADDRESS COMMAND 'delete >nil:' tempfile
  323. RETURN
  324.  
  325. userdata:
  326.   IF alias.n = 'ALIAS.'n THEN alias.n = ''
  327.   IF comm.n  = 'COMM.'n  THEN comm.n  = ''
  328.   showdata.1 = 'name    :' name.n
  329.   showdata.2 = 'address :' save.n
  330.   showdata.3 = 'alias   :' alias.n
  331.   showdata.4 = 'comment :' comm.n
  332.   showdata.5 = ''
  333.   showdata.6 = 'RETURN'
  334.   showdata.count = 6
  335.   titel = 'Userdata for' save.n
  336.   REQUESTLIST INSTEM showdata TITLE '"'titel'"' SIZEGADGET
  337.   IF (RC = 30) THEN DO
  338.     REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  339.     EXIT
  340.   END
  341.   IF RC ~= 5 THEN DO
  342.     sel = RESULT
  343.     IF sel = showdata.1 THEN DO
  344.       RESULT = name.n
  345.       REQUESTSTRING TITLE '"Enter a name for"' BT '"_OK|_From:|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'name.n'"'
  346.       IF THORRC = 0 then name.n = ''
  347.       IF THORRC = 1 then name.n = RESULT
  348.       IF THORRC = 2 THEN name.n = fromname
  349.     END
  350.     IF sel = showdata.2 THEN DO
  351.       RESULT = save.n
  352.       REQUESTSTRING TITLE '"Change address"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'save.n'"'
  353.       save.n = RESULT
  354.     END
  355.     IF sel = showdata.3 THEN DO
  356.       RESULT = alias.n
  357.       REQUESTSTRING TITLE '"Enter an alias for"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'alias.n'"'
  358.       alias.n = RESULT
  359.     END
  360.     IF sel = showdata.4 THEN DO
  361.       RESULT = comm.n
  362.       REQUESTSTRING TITLE '"Enter a comment for"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'comm.n'"'
  363.       comm.n = RESULT
  364.     END
  365.     IF sel = 'RETURN' THEN SIGNAL listsave(2)
  366.     SIGNAL userdata
  367.   END
  368.   ELSE SIGNAL main
  369. RETURN
  370.  
  371. save_userdata:
  372.   DROP USER.
  373.   DO i = 1 TO save.count
  374.     IF name.i = '' THEN DO
  375.       PARSE VAR save.i part1 '@'
  376.       name.i = part1
  377.     END
  378.     USER.NAME      = name.i
  379.     USER.ADDRESS   = save.i
  380.     USER.ALIAS     = alias.i
  381.     USER.COMMENT.1 = comm.i
  382.     IF USER.COMMENT.1 = '' THEN USER.COMMENT.COUNT = 0
  383.     ELSE USER.COMMENT.COUNT = 1
  384.     ADDRESS BBSREAD WRITEBRUSER BBSNAME '"'bbs'"' STEM USER ONLYIFEXIST
  385.     IF RC~=0 THEN DO
  386.       REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
  387.       CALL EXIT
  388.     END
  389.   END
  390.   IF loop = 1 THEN SIGNAL main
  391. RETURN
  392. /* end getemail */
  393.  
  394. filter:
  395.   PARSE ARG adres,lngth,fltr
  396.   IF fltr = 2 THEN adres=REVERSE(adres)
  397.   DO i = 1 TO filter.fltr.count
  398.     check = POS(filter.fltr.i, adres)
  399.     IF check ~=0 THEN adres = DELSTR(adres, check)
  400.   END
  401.   punt = LASTPOS('.', adres)
  402.   IF punt ~=0 THEN lngth = length(adres)
  403.   IF (punt = lngth) THEN adres = DELSTR(adres, punt)
  404.   IF fltr = 2 THEN adres=REVERSE(adres)
  405. RETURN(adres)
  406.  
  407. listfound:
  408.   IF found.COUNT > 0 THEN DO
  409.     REQUESTLIST INSTEM found OUTSTEM save TITLE '"Select address(es) to save"' MULTISELECT SIZEGADGET
  410.     IF (RC = 30) THEN DO
  411.       REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  412.       EXIT
  413.     END
  414.     IF RC ~= 5 THEN ok = 1
  415.   END
  416.   IF found.COUNT = 0 THEN DO
  417.     REQUESTNOTIFY '"No addresses found in this message."' '"_Ok"'
  418.     EXIT
  419.   END
  420. RETURN
  421.  
  422. listsave:
  423.   PARSE ARG soort
  424.     DO i = 1 TO save.count
  425.       IF name.i = 'NAME.'i THEN name.i = ''
  426.       showname.i = LEFT(name.i,20,' ')
  427.       show.i = showname.i' - 'save.i
  428.     END
  429.     sep = save.count +1
  430.     but = save.count +2
  431.     show.sep = ''
  432.     show.but = 'SAVE'
  433.     show.count = save.count+2
  434.   IF soort = 1 THEN titel = 'Select to enter a name'
  435.   IF soort = 2 THEN titel = 'Select address to edit userdata'
  436.   REQUESTLIST INSTEM show TITLE '"'titel'"' SIZEGADGET
  437.   IF (RC = 30) THEN DO
  438.     REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  439.     EXIT
  440.   END
  441.   IF RC ~= 5 THEN DO
  442.     selected = RESULT
  443.     IF selected = 'SAVE' THEN DO 
  444.       IF soort = 1 THEN SIGNAL savehotlist
  445.       IF soort = 2 THEN SIGNAL save_userdata
  446.     END
  447.     DO n = 1 TO save.count
  448.       IF selected = show.n THEN DO
  449.         IF soort = 1 THEN DO
  450.           REQUESTSTRING title '"Enter a name"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'name.n'"'
  451.           name.n = RESULT
  452.         END
  453.         IF soort = 2 THEN SIGNAL userdata
  454.       END
  455.     END
  456.     IF soort = 1 THEN SIGNAL listsave(1)
  457.     IF soort = 2 THEN SIGNAL listsave(2)
  458.   END
  459. RETURN
  460.